VERSION 5.00
Begin VB.UserControl TextEdit 
   BorderStyle     =   1  'Fixed Single
   ClientHeight    =   2670
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   4365
   ScaleHeight     =   178
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   291
   ToolboxBitmap   =   "TextEdit.ctx":0000
   Begin VB.Timer tmrTimer 
      Enabled         =   0   'False
      Interval        =   50
      Left            =   765
      Top             =   615
   End
   Begin VB.TextBox txtTextarea 
      BorderStyle     =   0  'None
      BeginProperty Font 
         Name            =   "Courier New"
         Size            =   9
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   645
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   1
      Top             =   0
      Width           =   1215
   End
   Begin VB.PictureBox picLine 
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      BackColor       =   &H00E6E6E6&
      BorderStyle     =   0  'None
      Height          =   2400
      Left            =   0
      ScaleHeight     =   160
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   43
      TabIndex        =   0
      TabStop         =   0   'False
      Top             =   0
      Width           =   645
      Begin VB.Line lbSpacer 
         BorderColor     =   &H8000000C&
         X1              =   42
         X2              =   42
         Y1              =   0
         Y2              =   35
      End
   End
End
Attribute VB_Name = "TextEdit"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long

Private Const EM_GETFIRSTVISIBLELINE As Long = &HCE
Private Const EM_GETLINECOUNT As Long = &HBA
Private Const EM_LINEFROMCHAR As Long = &HC9
Private Const EM_GETLINE As Long = &HC4
Private Const EM_LINEINDEX = &HBB
Private Const EM_UNDO = &HC7
Private Const WM_CUT = &H300
Private Const WM_COPY = &H301
Private Const WM_PASTE = &H302
Private Const WM_CLEAR = &H303
'Event Declarations:
Event Change()

Public Sub SetActive()
On Error Resume Next
    Call txtTextarea.SetFocus
End Sub

Public Sub Undo()
    SendMessage txtTextarea.hwnd, EM_UNDO, ByVal 0&, ByVal 0&
End Sub

Public Sub SelectAll()
    txtTextarea.SelStart = 0
    txtTextarea.SelLength = Len(txtTextarea.Text)
    Call txtTextarea.SetFocus
End Sub

Public Sub Cut()
On Error Resume Next
   SendMessage txtTextarea.hwnd, WM_CUT, 0, ByVal 0&
    Call txtTextarea.SetFocus
End Sub

Public Sub Copy()
On Error Resume Next
    SendMessage txtTextarea.hwnd, WM_COPY, 0, ByVal 0&
    Call txtTextarea.SetFocus
End Sub

Public Sub Paste()
On Error Resume Next
    txtTextarea.SelText = Replace(Clipboard.GetText(vbCFText), vbTab, String$(8, " "))
    Call txtTextarea.SetFocus
End Sub

Private Sub DrawLines()
Dim Counter As Long
Dim sLine As String

    'This sub draws the line numbers
    With picLine
        'Clear DC
        Call .Cls
        Set .Font = txtTextarea.Font
        For Counter = (GetVisableLine + 1) To GetLineCount
            'Set normal text color
            .ForeColor = vbBlack
            .CurrentX = (.Width - 10) - .TextWidth(Str$(Counter))
            If (Counter = LineIndex) Then
                'Set line heighlight color
                .ForeColor = &H808080
            End If
            'Print lines
            picLine.Print Counter
        Next Counter
    End With
    
End Sub

Private Function LineIndex() As Long
    LineIndex = SendMessage(txtTextarea.hwnd, EM_LINEFROMCHAR, (txtTextarea.SelStart + txtTextarea.SelLength), 0) + 1
End Function

Private Function GetLineCount() As Long
    GetLineCount = SendMessage(txtTextarea.hwnd, EM_GETLINECOUNT, 0, 0)
End Function

Private Function GetVisableLine() As Long
    GetVisableLine = SendMessage(txtTextarea.hwnd, EM_GETFIRSTVISIBLELINE, 0, 0)
End Function

Private Sub picLine_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim ln As Integer
On Error Resume Next
    If Button = vbLeftButton Then
        'Calc line
        ln = (Y \ picLine.TextHeight("Az"))
        txtTextarea.SelStart = SendMessage(txtTextarea.hwnd, EM_LINEINDEX, ln, 0)
        Call txtTextarea.SetFocus
    End If
End Sub

Private Sub tmrTimer_Timer()
    Call DrawLines
End Sub

Private Function GetNoneSpaceIdx(s0 As String) As Integer
Dim i As Integer
Dim Idx As Integer
    
    For i = 1 To Len(s0)
        If Mid(s0, i, 1) <> " " Then
            Idx = i
            Exit For
        End If
    Next i
    
    GetNoneSpaceIdx = Idx
    
End Function

Private Sub txtTextarea_KeyPress(KeyAscii As Integer)
Dim Lines() As String
Dim Idx As Integer
On Error Resume Next
    'Select all text
    Dim PrevLn As Integer
    
    PrevLn = SendMessage(txtTextarea.hwnd, EM_LINEFROMCHAR, -1, 0)
    
    'Auto tab
    If KeyAscii = 13 Then
        Lines = Split(txtTextarea.Text, vbCrLf)
        If PrevLn = 0 And Len(txtTextarea.Text) = 0 Then Exit Sub
        'Get size of spaces
        Idx = GetNoneSpaceIdx(Lines(PrevLn))
        
        If (Idx > 1) Then
            txtTextarea.SelText = vbCrLf & String$(Idx, " ")
            txtTextarea.SelStart = txtTextarea.SelStart - 1
            KeyAscii = 0
        End If
        Erase Lines
    End If
    
    'Auto close "
    If KeyAscii = 34 Then
        txtTextarea.SelText = """"
        txtTextarea.SelStart = txtTextarea.SelStart - 1
    End If
    
    'Auto close {
    If KeyAscii = 123 Then
        txtTextarea.SelText = "}"
        txtTextarea.SelStart = txtTextarea.SelStart - 1
    End If
    
    If (KeyAscii = 1) Then
        txtTextarea.SelStart = 0
        txtTextarea.SelLength = Len(txtTextarea.Text)
        txtTextarea.SetFocus
        KeyAscii = 0
    End If
    If (KeyAscii = 9) Then
        txtTextarea.SelText = Space(4)
        KeyAscii = 0
    End If
    
End Sub

Private Sub UserControl_Resize()
On Error Resume Next
    picLine.Height = (UserControl.ScaleHeight)
    lbSpacer.y2 = picLine.ScaleHeight
    'Resize editor
    txtTextarea.Height = (UserControl.ScaleHeight - txtTextarea.Top)
    txtTextarea.Width = (UserControl.ScaleWidth - txtTextarea.Left)
End Sub

Public Property Get Locked() As Boolean
Attribute Locked.VB_Description = "Determines whether a control can be edited."
    Locked = txtTextarea.Locked
End Property

Public Property Let Locked(ByVal New_Locked As Boolean)
    txtTextarea.Locked() = New_Locked
    PropertyChanged "Locked"
End Property

Public Property Get Text() As String
Attribute Text.VB_Description = "Returns/sets the text contained in the control."
    Text = txtTextarea.Text
End Property

Public Property Let Text(ByVal New_Text As String)
    txtTextarea.Text() = New_Text
    PropertyChanged "Text"
End Property

Public Property Get BackColor() As OLE_COLOR
Attribute BackColor.VB_Description = "Returns/sets the background color used to display text and graphics in an object."
    BackColor = txtTextarea.BackColor
End Property

Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
    txtTextarea.BackColor() = New_BackColor
    PropertyChanged "BackColor"
End Property

Public Property Get Font() As Font
Attribute Font.VB_Description = "Returns a Font object."
Attribute Font.VB_UserMemId = -512
    Set Font = txtTextarea.Font
End Property

Public Property Set Font(ByVal New_Font As Font)
    Set txtTextarea.Font = New_Font
    PropertyChanged "Font"
End Property

Public Property Get ForeColor() As OLE_COLOR
Attribute ForeColor.VB_Description = "Returns/sets the foreground color used to display text and graphics in an object."
    ForeColor = txtTextarea.ForeColor
End Property

Public Property Let ForeColor(ByVal New_ForeColor As OLE_COLOR)
    txtTextarea.ForeColor() = New_ForeColor
    PropertyChanged "ForeColor"
End Property

'Load property values from storage
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)

    txtTextarea.Locked = PropBag.ReadProperty("Locked", False)
    txtTextarea.Text = PropBag.ReadProperty("Text", "Text1")
    txtTextarea.BackColor = PropBag.ReadProperty("BackColor", &H80000005)
    Set txtTextarea.Font = PropBag.ReadProperty("Font", Ambient.Font)
    txtTextarea.ForeColor = PropBag.ReadProperty("ForeColor", &H80000008)
    txtTextarea.SelLength = PropBag.ReadProperty("SelLength", 0)
    txtTextarea.SelStart = PropBag.ReadProperty("SelStart", 0)
    txtTextarea.SelText = PropBag.ReadProperty("SelText", "")
End Sub

Private Sub UserControl_Show()
    tmrTimer.Enabled = (UserControl.Ambient.UserMode)
End Sub

'Write property values to storage
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)

    Call PropBag.WriteProperty("Locked", txtTextarea.Locked, False)
    Call PropBag.WriteProperty("Text", txtTextarea.Text, "Text1")
    Call PropBag.WriteProperty("BackColor", txtTextarea.BackColor, &H80000005)
    Call PropBag.WriteProperty("Font", txtTextarea.Font, Ambient.Font)
    Call PropBag.WriteProperty("ForeColor", txtTextarea.ForeColor, &H80000008)
    Call PropBag.WriteProperty("SelLength", txtTextarea.SelLength, 0)
    Call PropBag.WriteProperty("SelStart", txtTextarea.SelStart, 0)
    Call PropBag.WriteProperty("SelText", txtTextarea.SelText, "")
End Sub

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=txtTextarea,txtTextarea,-1,SelLength
Public Property Get SelLength() As Long
Attribute SelLength.VB_Description = "Returns/sets the number of characters selected."
    SelLength = txtTextarea.SelLength
End Property

Public Property Let SelLength(ByVal New_SelLength As Long)
    txtTextarea.SelLength() = New_SelLength
    PropertyChanged "SelLength"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=txtTextarea,txtTextarea,-1,SelStart
Public Property Get SelStart() As Long
Attribute SelStart.VB_Description = "Returns/sets the starting point of text selected."
    SelStart = txtTextarea.SelStart
End Property

Public Property Let SelStart(ByVal New_SelStart As Long)
    txtTextarea.SelStart() = New_SelStart
    PropertyChanged "SelStart"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=txtTextarea,txtTextarea,-1,SelText
Public Property Get SelText() As String
Attribute SelText.VB_Description = "Returns/sets the string containing the currently selected text."
    SelText = txtTextarea.SelText
End Property

Public Property Let SelText(ByVal New_SelText As String)
    txtTextarea.SelText() = New_SelText
    PropertyChanged "SelText"
End Property

Private Sub txtTextarea_Change()
    RaiseEvent Change
End Sub

